home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-13 / me_cd22.zip / MUTT2.ZIP / QUEEN.MUT < prev    next >
Lisp/Scheme  |  1992-04-27  |  2KB  |  84 lines
  1.   ;; place N queens on a NxN board
  2.   ;; C Durland    Public Domain
  3.  
  4. (include me2.h)
  5.  
  6. (array small-int boardx 20 boardy 20)
  7. (small-int nQueens N)
  8.  
  9. (defun
  10.   put-queen (int x y)(s)
  11.   {
  12.     (move-cursor (+ y 1) (+ 1 (* x 2)))(puts s)(update)
  13.   }
  14.   print-board
  15.   {
  16.     (move-cursor 0 0)
  17.     (puts ".---------------.^M^J")
  18.     (puts "|*|*|*|*|*|*|*|*|^M^J")
  19.     (puts "|*|*|*|*|*|*|*|*|^M^J")
  20.     (puts "|*|*|*|*|*|*|*|*|^M^J")
  21.     (puts "|*|*|*|*|*|*|*|*|^M^J")
  22.     (puts "|*|*|*|*|*|*|*|*|^M^J")
  23.     (puts "|*|*|*|*|*|*|*|*|^M^J")
  24.     (puts "|*|*|*|*|*|*|*|*|^M^J")
  25.     (puts "|*|*|*|*|*|*|*|*|^M^J")
  26.     (puts "`---------------'")
  27.   }
  28. )
  29.  
  30.  
  31. (defun
  32.   print-solution
  33.   {
  34.     (int j)
  35.     (for (j 0)(< j N)(+= j 1) (msg "(" (boardx j) "," (boardy j) ")"))
  36.   }
  37.   threat (int a b x y)
  38.   {
  39.     (or
  40.       (== a x)(== b y)
  41.       (== (- a b)(- x y))
  42.       (== (+ a b)(+ x y))
  43.     )
  44.   }
  45.   conflict (int x y)
  46.   {
  47.     (int n)
  48.     (for (n 0)(< n nQueens)(+= n 1)
  49.       (if (threat x y (boardx n) (boardy n)) { TRUE (done) }))
  50.     FALSE
  51.   }
  52.   fill-board (int x y)
  53.   {
  54.     (int i j z)(z x)
  55.  
  56.     (for (i z)(< i N)(+= i 1)
  57.     {
  58.       (for (j z)(< j N)(+= j 1)
  59.       {
  60.         (if (conflict i j) ()
  61.     {
  62.       (put-queen i j nQueens)
  63.       (boardx nQueens i)(boardy nQueens j)(+= nQueens 1)
  64.       (fill-board i j)
  65.       (if (== nQueens N){ TRUE (done) })
  66.       (-= nQueens 1)(put-queen i j ".")
  67.     })
  68.       })
  69.       (z 0)
  70.     })
  71.     FALSE
  72.   }
  73.   Queens
  74.   {
  75.     (N (convert-to NUMBER (ask "Number of queens (max 8) = ")))
  76.     (if (or (> N 8) (< N 1)) { (msg "Bogus number of queens")(done) })
  77.     (nQueens 0)(print-board)
  78.     (if (fill-board 0 0) (msg "done")
  79.     (msg "No solution"))
  80.   }
  81. )
  82.  
  83. (defun MAIN { (Queens) })
  84.